(*
* Bank simulation
*)

open Constants
open ExtList
open List
open Option
open Printf
open Management 
open Bmap
open Types ;;

type bankID = int

type accounts = int

type loanBook =
    { principalSum : cash ;
      contracts : contract list }

let valueBook { principalSum = ps } = ps

let bondPart = function
  | Bond x -> Some x
  | _ -> None

let defaultedP = function
  | DefaultedBond _ -> true
  | _ -> false

(*
let rec filterMap f l =
  match l with
  | [] -> []
  | (o :: os) -> 
      let res = f o in
      if is_some res
      then (get res) :: (filterMap f os)
      else (filterMap f os)
*)

let printLoanBook {principalSum = ps ;
		   contracts = c  } = 
  let get_rate { rate = r} = r in
  let get_maturity { maturity = r} = r in
  let avgrate =  meanv (List.map get_rate (List.filter_map bondPart c)) in
  let avgdur =  meanv (List.map (fun x -> (dateFloat (get_maturity x))) (List.filter_map bondPart c)) in
  (sprintf "%10.2f -  #loans: %3d  avgRt: %5.2f%%  avgDur: %5.2f  #def: %3d"
     ps 
     (List.length c) 
     (avgrate *. 100.0)
     avgdur
     (List.length (List.filter defaultedP c)))

let summer = fun c b ->
  match b with
  | Bond {principal = p} -> c +. p
  | DefaultedBond {defprincipal = p} -> c +. p
  | _ -> c

let valBL cs = List.fold_left (summer) 0.0 cs

let valueBookMaturity dt { contracts = cs } m1 m2 =
  List.fold_left (fun c b -> if (maturityBetween b dt m1 m2) then (summer c b) else c) 0.0 cs


let colCon cs = { principalSum = valBL cs; contracts = cs }

let loanBookContracts { contracts = c } = c


let isNullBond = function
  | NullBond -> true
  | _ -> false


(* this is for the learner - records facts about the bank and the 
ultimate state of the bank *)




type bank
    = { management: management; 
        bankcash: cash ;
        assets : loanBook ;
        liabilities : loanBook;
        deposits: cash ;
        depositRate: float ;
        (* statistics and accounting *)
        profit : cash list;
        dividends : cash list;
        costs: int ;
        accounts : accounts; (* Map.Map (Date,AccID) Double *)
        bankID : bankID ;
	(* cached values *)
	book_equity : float;
	capital_ratio : float;
	liquid_ratio : float;
        (* regulation and failure *)
	regulator_control:bool;  (* is the institution under self or reg. management *)
	failTime: float;
	failPenalty: cash;
	(* contract history *)
	accepted_lender_contracts : bmap;
	accepted_borrower_contracts : bmap;
	rejected_lender_contracts : bmap;
	rejected_borrower_contracts : bmap;
	  
      }

(*
-- bonds pay interest on month 0
stepBond :: Date -> Contract -> Double -> (Contract,Double,Double)
*)



let bookEquityC { assets = asst;
		 liabilities = liab;
		 bankcash = cash;
		 deposits = deps }=
  let loanval = valueBook asst in
  let liabval = valueBook liab in
  cash +. loanval -. liabval -. deps

let bsgap d b m1 m2 =
  let assside = valueBookMaturity d b.assets m1 m2 in
  let liabside = valueBookMaturity d b.liabilities m1 m2 in
  assside -. liabside

let riskWeightedAssets { assets = { principalSum = amt }} = amt
(* for now cash has weighting 0, all else weighting 1 *)

let valueBank b
    = bookEquityC b 
(* use book values for now - TODO - need a better model here if we implement takeovers  *)

let bankCapitalC b
    = (valueBank b) /. riskWeightedAssets b

let bankLiquidityC { assets = asst;
		    bankcash = cash }
    = cash /. (cash +. valueBook asst )

let updateCache b =
  { b with capital_ratio = bankCapitalC b;
           liquid_ratio = bankLiquidityC b;
           book_equity = bookEquityC b }

let acceptCCol 
    { principalSum = cc ;
      contracts = clist } c =
    let {principal = p} = c in
    { principalSum = cc +. p;
      contracts = (Bond c) :: clist }

let stepBond now tbond randnum = 
  match tbond with
  | ( DefaultedBond {recdate = d; recamount = a} )  ->
      if d >= now
      then (NullBond,a,0.,0.)
      else (tbond,0.,0.,0.)
  | NullBond -> (NullBond,0.,0.,0.)
  | (Bond {maturity=m;principal=p;rate=r ;rdefault=rd;recovery=reca}) -> 
      let interest = if (monthPart (diffDate m now)) == 0
                     then p *. r
                     else 0. in 
      let ncash = if now >= m
                  then p *. (r +. 1.)
                  else interest in
      let nbond = if now >= m
                  then NullBond
                  else tbond 
      in if randnum < rd /. (float_of_int miy)
         then ((DefaultedBond { recamount = p *. reca;
				recdate = sumDate now timeToRecover ; 
                                defprincipal = p}),
                    0.,0., p *. (1. -. reca))
         else (nbond,ncash,interest,0.)

let lastprofit = function
  | { profit = x :: _ } -> x
  | { profit = [] } -> 0.0


(* divs are paid monthy - essentially put into a "dividend" account and then commited. *)

let payDividendAndTax b
    = let { management = mgt;
	    bankcash= bc;
	    dividends = odivs} = b in 
      let tax = ((taxrate /. miyf) *. (lastprofit b)) in
      let divs = (((divrate b mgt)/.miyf) *. 
		    (lastprofit b -. tax)) in
      if lastprofit b > 0.0
      then {b with bankcash = bc -. divs -. tax;
            dividends = divs::odivs }
      else {b with dividends = 0.0::odivs }


let stepper d (oa,oc,ii,losses) a = 
    let rn = Random.float 1.0 (* (0,1] *) in
    let (b,c,i,l) = (stepBond d a rn) 
    in (b :: oa, c +. oc, i +. ii,l +. losses)

let liabstepper d (oa,oc,ii,ll) a = 
    let rn = 0.01 in
    let (b,c,i,l) = (stepBond d a rn) 
    in (b :: oa, c +. oc, i +. ii,l+.ll)


let stepBank date cashrate keepAccounts bank =
  let {bankcash=cash;
       assets=ass;
       liabilities=liab;
       deposits = deps ;
       depositRate = depr; 
       profit = p;
       costs = bcosts} = bank in
  let (nassets0,newcash,interestincome,provisions) = List.fold_left (stepper date) 
      ([],0.0,0.0,0.0) (loanBookContracts ass) in
  let (nliab0,newpays,interestexpense,_) = List.fold_left (liabstepper date) 
      ([],0.0,0.0,0.0) (loanBookContracts liab) in
  let fil x = (not (isNullBond x)) in
  let nassets = List.filter fil nassets0 in
  let nliab = List.filter fil nliab0 in
  let deprate = (depr +. cashrate) /. miyf in
  let depcost =  deps *. deprate in (* -- cost of deposit funding *)
  let cashincome =  cash *. cashrate /. miyf in
  let opCosts = costFactor *. (float_of_int bcosts) in
  (* printf "date %f cashrate %f cash %f newcash %f cashincome %f newpays %f depcost %f opCosts %f\n"
    (dateFloat date) cashrate cash newcash  cashincome  newpays  depcost  opCosts ; *)
  let fcash = cash +.  newcash +. cashincome -. newpays -. depcost -. opCosts in
  let nii = interestincome +. cashincome -. interestexpense -. depcost in
  let pretaxprof = nii -. provisions -. opCosts in 
  updateCache (payDividendAndTax {bank with 
				  bankcash = fcash;
				  assets = colCon nassets;
				  liabilities =  colCon nliab;
				  profit = pretaxprof :: p;
				  costs = 0 } )



(*
* The folowing is the original haskell for accounts.
*
                    nbank = if keepAccounts
                            then nbank0 { accounts = nent `deepseq`{-# SCC "lnum97e" #-}insEntries date nent (accounts b) }
                            else nbank0
                    p =  {-# SCC "lnum102" #-} management b
                    (asst,ass) =  {-# SCC "lnum104" #-} assets b
                    (liabt,liab) =  {-# SCC "lnum105" #-} liabilities b
                    totassets =  {-# SCC "lnum106" #-} asst + bankcash b
                    totliab =  {-# SCC "lnum107" #-} liabt + deps
                    equity =  {-# SCC "lnum108" #-} totassets - totliab
                    --
                    rc =  {-# SCC "lnum111" #-} regulator_control b
                    -- statistics
                    divs =  {-# SCC "lnum113" #-} dividends b 
                    nim' =  {-# SCC "lnum114" #-} nii * (fromIntegral $ miy) / totassets
                    roa' =  {-# SCC "lnum115" #-} (pretaxprof * (fromIntegral $ miy)) / totassets 
                    roe' =  {-# SCC "lnum116" #-} (pretaxprof * (fromIntegral $ miy)) / equity
                    -- TODO interest spread needs to be added
                    nent = {-# SCC "lnum118" #-}  [ -- Balance Sheet
                             (aid "Cash",{-# SCC "lnum120" #-} cash),
                             (aid "Loan Assets",{-# SCC "lnum121" #-}asst),
                             (aid "Total Assets",{-# SCC "lnum122" #-}totassets),
                             (aid "Deposit Liab",{-# SCC "lnum123" #-}deps),
                             (aid "Loan Liab",{-# SCC "lnum124" #-}liabt),
                             (aid "Total Liab",{-# SCC "lnum125" #-}totliab),
                             (aid "Equity",{-# SCC "lnum126" #-}equity),
                             -- Income statement
                             (aid "Interest Income",{-# SCC "lnum128" #-}interestincome + cashincome),
                             (aid "Interest Expense",{-# SCC "lnum129" #-}interestexpense + depcost),
                             (aid "Net Interest Income",{-# SCC "lnum130" #-}nii),
                             (aid "Provisions",{-# SCC "lnum131" #-}provisions),
                             (aid "PreTaxProfit",{-# SCC "lnum132" #-}pretaxprof),
                             (aid "Costs", opCosts),
                             (aid "TODO Dividends", {-# SCC "lnum134" #-}0),
                             (aid "TODO Tax",0),
                             -- Statistics
                             (aid "Net Interest Margin",{-# SCC "lnum135" #-}nim'),
                             (aid "Return on Assets",{-# SCC "lnum136" #-}roa'),
                             (aid "Return on Equity",{-# SCC "lnum137" #-}roe') ]
                in {-# SCC "lnum138" #-}nbank)
*)

let print_bank b  = 
    (sprintf "Bank %d %s:\nAssets:\n Cash:  %10.2f\n Loans: %s\n Total: %10.2f\nLiabilities:\n Deps:  %10.2f\n Debt:  %s\n Total: %10.2f\nEquity:\n Ordry: %10.2f\n History; LendAcc: %d LendRej: %d BorrAcc: %d BorrRej %d\n"
       b.bankID
       (if b.regulator_control
       then " *** UNDER REGULATOR CONTROL ***"
       else " (management control)")
    b.bankcash
    (printLoanBook b.assets)
    (b.bankcash +. valueBook b.assets)
    b.deposits
    (printLoanBook b.liabilities)
    (b.deposits +. valueBook b.liabilities)
    (b.book_equity)
       (Bmap.length (b.accepted_lender_contracts))
       (Bmap.length (b.rejected_lender_contracts : bmap ))
       (Bmap.length (b.accepted_borrower_contracts : bmap ))
       (Bmap.length (b.rejected_borrower_contracts : bmap))
    )
    

(* TODO - does not print P+L or cash flows *)

let rec nStepBank = 
  fun n d b ->
    print_string (print_bank b);
    let ndate = incDate d in
    match n with
    | 0 -> b
    | _ -> nStepBank (n-1) ndate (stepBank ndate 0.03 true b)


let sumDividends { dividends = d } = sum d

let bank_score b = 
  if b.regulator_control
  then b.failPenalty *. b.failTime +. (sumDividends b)
  else (sumDividends b) +. 0.0002 *. b.book_equity




let contract_state_build crw d b c acc =
  { cs_state = [ (if acc then 1.0 else 0.0);
                 -1.0; (* score *)
		 -1.0; (* reg_control *) 
		 (b.capital_ratio);
		 (b.liquid_ratio);
		 (crw);
		 (c.rate);
		 (dateFloat (diffDate c.maturity c.start));
		 (c.principal);
		 (bsgap d b 0. 0.5);
		 (bsgap d b 0.5 1.0);
		 (bsgap d b 1.0 3.0);
		 (bsgap d b 3.0 10.0);
	       ] }


let set_nth i ne list =
  let (s,(_::e)) = List.split_nth (i) list in
  s @ (ne :: e)

let contract_finalize bs rc c =
  let rcn = if rc then 1.0 else 0.0 in
  let nc = (set_nth cs_score bs (set_nth cs_reg_control rcn c.cs_state)) in
  {c with cs_state = nc }

let bank_finalize b =
  let bs = bank_score b in
  let rc = b.regulator_control in
  { b with 
    accepted_lender_contracts = 
          bmap_map (contract_finalize bs rc) b.accepted_lender_contracts;
    accepted_borrower_contracts =
          bmap_map (contract_finalize bs rc) b.accepted_borrower_contracts;
    rejected_lender_contracts = 
          bmap_map (contract_finalize bs rc) b.rejected_lender_contracts;
    rejected_borrower_contracts =
          bmap_map (contract_finalize bs rc) b.rejected_borrower_contracts; }


(*
accept_contract :: Party -> Date -> Bank -> Contract -> Bank
*)
let accept_contract party d b c=
  let { principal = prin } = c in
  let { liabilities = liab;
        assets = assts;
        bankcash = bcash } = b in
  let newcs = (contract_state_build 0.0 d b c true) in
  match party with
  | Lender -> (* LENDER == WHOLESALE FUNDING == CREATES A LIABILITY == MORE CASH *)
      let nliab = acceptCCol liab c in
      updateCache {b with liabilities = nliab;
		   bankcash = bcash +. prin ;
		   accepted_lender_contracts = add newcs b.accepted_lender_contracts}
  | Borrower -> (* BORROWER == NEW LOAN == CREATES AN ASSET == LESS CASH *)
      if (bcash -. prin < 0.)
      then { b with rejected_borrower_contracts = add newcs b.rejected_borrower_contracts }
           (* Cannot accept contract *)
      else let nassts = acceptCCol assts c in
           updateCache {b with assets = nassts;
			bankcash = bcash -. prin  ;
			accepted_borrower_contracts = add newcs b.accepted_borrower_contracts}

let reject_contract party d b c = 
  let newcs = (contract_state_build 0.0 d b c false) in
 match party with
  | Lender -> { b with rejected_lender_contracts = add newcs b.rejected_lender_contracts }
  | Borrower -> { b with rejected_borrower_contracts = add newcs b.rejected_borrower_contracts }
